home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Auge 4000 / Auge 4000 #25 (1988-06-25)(Amiga User Gruppe Einzugsgebiet 4000).zip / Auge 4000 #25 (1988-06-25)(Amiga User Gruppe Einzugsgebiet 4000).adf / body / Body (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-04-10  |  9KB  |  290 lines
  1. DIM Stati&(9,30):DIM o&(9,2):DIM p(9):DIM U%(50): DIM U$(50)
  2. Sounda=440:Soundc=523.25:Soundd=587.33:sounde=659.26:soundf=698.46:Soundg=783.99:Sounda=880:Sounddc=261.63:Soundh=493.88:soundgd=392
  3. PALETTE 3,0.47,0.87,1
  4. COLOR 3,0
  5. PRINT:PRINT:PRINT:PRINT:PRINT
  6. PRINT"       ®®®®®®  ®®®®®®  ®®®®   ®     ® "
  7. PRINT"       ®    ®  ®    ®  ®   ®   ®   ®  "
  8. PRINT"       ®    ®  ®    ®  ®   ®    ® ®   "
  9. PRINT"       ®®®®®®  ®    ®  ®   ®     ®    "
  10. PRINT"       ®    ®  ®    ®  ®   ®     ®    "
  11. PRINT"       ®    ®  ®    ®  ®   ®     ®    "
  12. PRINT"       ®®®®®®  ®®®®®®  ®®®®      ®    "
  13. PRINT
  14. PRINT"                by ROLLE "
  15. GOSUB Soundend
  16. FOR b=1 TO 5000:NEXT b
  17. CLS
  18. OPEN "R",#2,"Training",48
  19. FIELD #2, 2 AS Z$(7,1),4 AS g$(7,1),2 AS Z$(7,2),4 AS g$(7,2),2 AS Z$(7,3),4 AS g$(7,3),2 AS Z$(7,4),4 AS g$(7,4),2 AS Z$(8,1),4 AS g$(8,1),2 AS Z$(8,2),4 AS g$(8,2),2 AS Z$(8,3),4 AS g$(8,3),2 AS Z$(8,4),4 AS g$(8,4)
  20. PALETTE 2,0,0.93,0.87
  21. PALETTE 3,1,0.6,0.67
  22. OPEN "I",#4,"Namen"
  23. INPUT #4,b$(7),b$(8)
  24. CLOSE 4
  25. Anfang:
  26. COLOR 1,0
  27. b$(1)="Brust":b$(2)="Rücken":b$(3)="Schultern":b$(4)="Arme":b$(5)="Beine":b$(6)="Namen"
  28. FOR b= 1 TO 6
  29. MENU b,0,1,b$(b)
  30. MENU b,1,1,"Hinzufügen"
  31. NEXT
  32. MENU 6,1,1,b$(7)
  33. MENU 6,2,1,b$(8)
  34. MENU 6,3,1,"EXIT"
  35. MENU 6,4,1,"Statibügeln"
  36. Ubunglesen:
  37. OPEN "I",#1,"Übungen"
  38. d=0:A=0
  39. WHILE NOT EOF (1)
  40. A=A+1
  41. INPUT#1,U%(A),U$(A)
  42. WEND
  43. FOR b=1 TO 5
  44. d=1
  45. FOR c=1 TO A
  46. IF U%(c)=b THEN d=d+1:Satznum%(b,d)=c:MENU b,d,1,U$(c)
  47. NEXT c
  48. NEXT b
  49. CLOSE 1
  50. GOTO Auswahl
  51. Hinzufugen:
  52.   OPEN "a",#1,"Übungen"
  53. los:  
  54.   PRINT "Was soll bei ";b$(x);" hinzugefügt werden?"
  55.   INPUT ;U$
  56.   IF U$="" THEN CLOSE 1:GOTO Anfang
  57.   U%=x
  58.   PRINT #1,U%,U$
  59.   Z$(7,1)="":Z$(8,1)="‚‚"
  60.   PUT #2
  61.   OPEN "O",#3,U$
  62.   h=0:j=0
  63.   FOR i= 1 TO 30 
  64.   PRINT #3,h,j
  65.   NEXT i
  66.   CLOSE 3
  67.   TOT$=U$+".info"
  68.   KILL TOT$
  69.   CLOSE 1:GOTO Anfang
  70. Auswahl:
  71.   CLS
  72.   PRINT:PRINT "Bitte wählen sie jetzt die Teilnehmer aus":PRINT:PRINT "oder fügen sie eine Übung hinzu":PRINT:PRINT "oder beenden sie dieses Programm mit EXIT"
  73.   n=0
  74. Warten:
  75.   x=MENU (0):y=MENU(1)
  76.   SLEEP
  77.   IF n>1 AND n%(1)=n%(2)OR n>2THEN BEEP:CLS:PRINT:PRINT "Mit sich selbst nur beim Onanieren":PRINT:PRINT "Nochmal von vorn":n=0:GOTO Warten
  78.   IF x=6 AND y=3 THEN CLOSE 2:GOSUB Soundend:END
  79.   IF x=0 GOTO Warten
  80.   IF x=6 AND y=4 AND n=0 THEN GOTO Statibugeln
  81.   IF x=6 AND y=4 AND n><0 THEN PRINT:PRINT "Döskopp,wähle Partner oder Übung":GOTO Warten
  82.   IF x<6 AND y=1 THEN GOTO Warnung
  83.   IF x<6 AND n=0 THEN BEEP:PRINT:PRINT"Erst die Teilnehmer,Baby":GOTO Warten
  84.   IF x=6 AND y=1 THEN PRINT:PRINT b$(7):PRINT:PRINT "Noch jemand?":PRINT:PRINT "Oder eine Übung":n=n+1:n%(n)=7:GOTO Warten
  85.   IF x=6 AND y=2 THEN PRINT:PRINT b$(8):PRINT:PRINT "Noch jemand?":PRINT:PRINT "Oder eine Übung":n=n+1:n%(n)=8:GOTO Warten
  86.   IF x<6 AND n>0 THEN GOTO Training 
  87. Training:
  88.   GET #2,Satznum%(x,y)
  89.   FOR f=1 TO 4
  90.   Zahl%(7,f)=CVI(Z$(7,f))
  91.   Zahl%(8,f)=CVI(Z$(8,f))
  92.   Gewicht(7,f)=CVS(g$(7,f))
  93.   Gewicht(8,f)=CVS(g$(8,f))
  94.   NEXT f
  95. Trainingaction:
  96.   MENU 6,3,1,"Exit nach aktueller Eingabe"
  97.   FOR f= 1 TO 4  
  98.   FOR h= 1 TO n
  99.   IF n%(h)=7 THEN COLOR 0,2
  100.   IF n%(h)=8 THEN COLOR 0,3
  101.   CLS 
  102.   PRINT b$(n%(h)),:PRINT U$(Satznum%(x,y)):PRINT:PRINT "Satz","Anzahl","Gewicht in Kilo"
  103.   FOR i= 1 TO 4
  104.   PRINT i,Zahl%(n%(h),i),Gewicht(n%(h),i)
  105.   PRINT
  106.   NEXT i
  107.   PRINT "Satz ";f :PRINT
  108.   IF f=1 THEN PRINT " Return gibt ersten Wert aus alter Übung":PRINT
  109.   IF f>1 THEN PRINT "Return gibt Werte aus letztem Satz":PRINT
  110.   IF f>1 THEN PRINT "Letzter Satz",Zahl%(n%(h),f+3);"mal",Gewicht(n%(h),f+3);"kg":PRINT
  111.   INPUT "Anzahl";Zahl%(n%(h),f+4)
  112.   IF Zahl%(n%(h),f+4)=0 AND f=1 THEN Zahl%(n%(h),f+4)=Zahl%(n%(h),f):PRINT Zahl%(n%(h),f+4)
  113.   IF Zahl%(n%(h),f+4)=0 AND f>1 THEN Zahl%(n%(h),f+4)=Zahl%(n%(h),f+3):PRINT Zahl%(n%(h),f+4)
  114.   INPUT "Gewicht in Kilo";Gewicht(n%(h),f+4)
  115.   IF Gewicht(n%(h),f+4)=0 AND f=1 THEN Gewicht(n%(h),f+4)=Gewicht(n%(h),f):PRINT Gewicht(n%(h),f+4)
  116.   IF Gewicht(n%(h),f+4)=0 AND f>1 THEN Gewicht(n%(h),f+4)=Gewicht(n%(h),f+3):PRINT Gewicht(n%(h),f+4)
  117.   IF n%(h)=7 THEN GOSUB soundeins
  118.   IF n%(h)=8 THEN GOSUB soundzwei
  119.   IF MENU(0)=6 AND MENU (1)=3 THEN GOTO Anfang
  120.   NEXT h
  121.   NEXT f
  122.   FOR h= 7 TO 8
  123.   m&(h)=0
  124.   FOR f= 1 TO 4
  125.   m&(h)=m&(h)+Gewicht(h,f+4)*Zahl%(h,f+4)
  126.   NEXT f
  127.   NEXT h
  128.   IF n=2 GOTO Trainingspeichern
  129.   IF n=1 GOTO Trainingspeicherneins
  130. Trainingspeichern:
  131.   FOR f= 1 TO 4
  132.   LSET Z$(7,f)=MKI$(Zahl%(7,f+4))
  133.   LSET Z$(8,f)=MKI$(Zahl%(8,f+4))
  134.   LSET g$(7,f)=MKS$(Gewicht(7,f+4))
  135.   LSET g$(8,f)=MKS$(Gewicht(8,f+4))
  136.   NEXT f
  137.   PUT #2,Satznum%(x,y)
  138.   GOTO Statilesen 
  139. Trainingspeicherneins:
  140.   FOR f= 1 TO 4
  141.   IF n%(n)=7 THEN LSET Z$(7,f)=MKI$(Zahl%(7,f+4))
  142.   IF n%(n)=7 THEN LSET Z$(8,f)=MKI$(Zahl%(8,f))
  143.   IF n%(n)=7 THEN LSET g$(7,f)=MKS$(Gewicht(7,f+4))
  144.   IF n%(n)=7 THEN LSET g$(8,f)=MKS$(Gewicht(8,f))
  145.   IF n%(n)=8 THEN LSET Z$(7,f)=MKI$(Zahl%(7,f))
  146.   IF n%(n)=8 THEN LSET Z$(8,f)=MKI$(Zahl%(8,f+4))
  147.   IF n%(n)=8 THEN LSET g$(7,f)=MKS$(Gewicht(7,f))
  148.   IF n%(n)=8 THEN LSET g$(8,f)=MKS$(Gewicht(8,f+4))
  149.   NEXT f
  150.   PUT #2,Satznum%(x,y) 
  151. Statilesen:
  152.   GOSUB Soundend
  153.   OPEN "I",#3,U$(Satznum%(x,y))
  154.   FOR i= 1 TO 30
  155.   INPUT #3,Stati&(7,i),Stati&(8,i)
  156.   NEXT i
  157.   CLOSE 3
  158. Zahlersuchen:
  159.   s(7)=0:s(8)=0
  160.   FOR i= 1 TO 30
  161.   IF Stati&(7,i)>0 THEN s(7)=s(7)+1
  162.   IF Stati&(8,i)>0 THEN s(8)=s(8)+1
  163.   NEXT i  
  164.   FOR j=1 TO n
  165.   IF s(n%(j))<30 THEN Stati&(n%(j),s(n%(j))+1)=m&(n%(j))
  166.   IF s(n%(j))=30 AND s(n%(j))><0 THEN GOSUB Aufrucken
  167.   IF s(n%(j))=0 THEN Stati&(n%(j),1)=m&(n%(j))
  168.   NEXT j
  169. Speichern:
  170.   OPEN "o",#3,U$(Satznum%(x,y))
  171.   FOR i= 1 TO 30
  172.   PRINT #3,Stati&(7,i),Stati&(8,i)
  173.   NEXT i
  174.   CLOSE #3
  175.   TOT$=U$(Satznum%(x,y))+".info"
  176.   KILL TOT$
  177.   GOTO Statistik
  178. Aufrucken:
  179.   FOR i=1 TO 29
  180.   Ersatz&=Stati&(n%(j),i+1)
  181.   Stati&(n%(j),i)=Ersatz&
  182.   NEXT i
  183.   Stati&(n%(j),30)=m&(n%(j))
  184.   RETURN
  185. Statistik:
  186.   o&(7,1)=0:o&(7,2)=15000:o&(8,1)=0:o&(8,2)=15000
  187.   FOR j=1 TO n
  188.   FOR i=1 TO 30
  189.   IF Stati&(n%(j),i)<>0 THEN GOSUB Grossenrechnen
  190.   NEXT i
  191.   NEXT j
  192.   p#(7)=o&(7,1)-o&(7,2)
  193.   p#(8)=o&(8,1)-o&(8,2)
  194.   GOTO Statibild
  195. Grossenrechnen:
  196.   IF Stati&(n%(j),i)>o&(n%(j),1) THEN o&(n%(j),1)=Stati&(n%(j),i)
  197.   IF Stati&(n%(j),i)<o&(n%(j),2) THEN o&(n%(j),2)=Stati&(n%(j),i)
  198.   RETURN
  199. Statibild: 
  200.   SCREEN 2,330,250,2,1  
  201.   FOR j=1 TO n
  202.   IF o&(n%(j),1)=o&(n%(j),2)THEN SCREEN CLOSE 2:GOTO Anfang
  203.   WINDOW j+1,b$(n%(j)),(0,0)-(320,220),20,2
  204.   PALETTE 2,0,0.93,0.87
  205.   PALETTE 3,1,0.6,0.67
  206.   IF n%(j)=7 THEN COLOR 0,2
  207.   IF n%(j)=8 THEN COLOR 0,3
  208.   LINE (20,1)-(20,200),1:LINE (320,200)-(20,200),1 
  209.   PRINT U$(Satznum%(x,y)) 
  210.   FOR v= 1 TO 25:PRINT:NEXT v
  211.   PRINT "HEUTE";m&(n%(j));"kg";
  212.   IF o&(n%(j),1)><m&(n%(j)) THEN PRINT " TOP";o&(n%(j),1);"kg";
  213.   IF o&(n%(j),1)=m&(n%(j))AND s(n%(j))<30 THEN PRINT " LETZTES MAL";Stati&(n%(j),s(n%(j)))" kg";
  214.   IF o&(n%(j),1)=m&(n%(j))AND s(n%(j))=30 THEN PRINT " LETZTES MAL";Stati&(n%(j),29)" kg";
  215.   FOR i=1 TO 30
  216.   IF Stati&(n%(j),i)<>0 THEN GOSUB Linienziehen
  217.   NEXT i
  218.   NEXT j
  219.   Statischluss:
  220.   w$=INKEY$
  221.   IF w$=CHR$(27) THEN SCREEN CLOSE 2:GOTO Anfang
  222.   GOTO Statischluss
  223. Linienziehen:    
  224.   q#=200/p#(n%(j))*(Stati&(n%(j),i)-o&(n%(j),2))
  225.   LINE -(i*10+10,200-CINT(q#)),1 
  226.    RETURN
  227. Statibugeln:  
  228.   CLS
  229.   PRINT "Statibügeln":PRINT
  230.   PRINT "Wählen sie den Namen"
  231.   War:
  232.   x=MENU (0):y=MENU(1)
  233.   SLEEP
  234.   IF x=0 GOTO War
  235.   IF x=6 AND y=3 THEN PRINT:PRINT "Ausgebügelt" :GOTO Anfang
  236.   IF x=6 AND y=1 AND n=0 THEN n=7:PRINT:PRINT "Welche Übung von ";b$(n):GOSUB soundeins:GOTO War
  237.   IF x=6 AND y=2 AND n=0 THEN n=8:PRINT:PRINT "Welche Übung von ";b$(n):GOSUB soundzwei:GOTO War
  238.   IF x=6 AND y=4 THEN PRINT:PRINT "Was tust du denn gerade,hä?":GOTO War
  239.   IF x=6 AND n>0 THEN BEEP:PRINT:PRINT "Die Übung,Mann!!!!":GOTO War  
  240.   IF y=1 THEN BEEP:PRINT:PRINT "Hirni!!!":GOTO War 
  241.   IF x<6 AND n=0 THEN BEEP:PRINT:PRINT "Erst den Namen":GOTO War
  242.   CLS
  243.   OPEN "I",#3,U$(Satznum%(x,y))
  244.   FOR i= 1 TO 30
  245.   INPUT #3,Stati&(7,i),Stati&(8,i)
  246.   NEXT i
  247.   CLOSE 3
  248.   MIT=0
  249.   Bugelbild:
  250.   CLS
  251.   PRINT:PRINT U$(Satznum%(x,y)),b$(n):PRINT
  252.   FOR i = 1 TO 30 STEP 3
  253.   PRINT  "Num";i;" Inh.";Stati&(n,i),"Num";i+1;"Inh.";Stati&(n,i+1),"Num";i+2;"Inh.";Stati&(n,i+2)
  254.   NEXT i
  255.   PRINT:INPUT "Welche Nummer (Beenden mit Return)";nummer
  256.   IF nummer=0 AND MIT=0 THEN GOTO Auswahl
  257.   IF nummer=0 THEN GOTO Bugelschluss
  258.   PRINT "Welcher Wert in";nummer:INPUT Stati&(n,nummer)
  259.   MIT=MIT+1:GOTO Bugelbild
  260. Bugelschluss:  
  261.   SOUND Soundd,18,,0
  262.   OPEN "o",#3,U$(Satznum%(x,y))
  263.   FOR i= 1 TO 30
  264.   PRINT #3,Stati&(7,i),Stati&(8,i)
  265.   NEXT i
  266.   CLOSE #3
  267.   GOTO Anfang
  268. soundeins:  
  269. SOUND WAIT:SOUND Soundd,9,,0:SOUND Soundg,9,,1:SOUND Soundc,9,,0:SOUND soundf,9,,1:SOUND RESUME:RETURN
  270. soundzwei:                                  
  271. SOUND WAIT:SOUND Sounda,9,,0:SOUND Soundd,9,,1:SOUND Soundh,9,,0:SOUND sounde,9,,1:SOUND RESUME:RETURN
  272. Soundend:
  273. SOUND WAIT:SOUND Soundg,9,,0:SOUND Sounda,27,,0:SOUND Soundg,9,,0:SOUND Soundd,9,,1:SOUND sounde,9,,1:SOUND Soundc,9,,1:SOUND Sounddc,9,,1:SOUND soundgd,9,,1:SOUND RESUME:RETURN
  274. Warnung:
  275. WINDOW 2,"Achtung",(1,1)-(300,100),2
  276. LINE (1,50)-(100,90),1,b
  277. LINE (190,50)-(290,90),1,b
  278. LOCATE 1,1:PRINT "Das Hinzufügen ist nicht"
  279. PRINT"rückgängig zu machen"
  280. PRINT:PRINT "Sind sie sicher?"
  281. LOCATE 9,5:PRINT "JA"
  282. LOCATE 9,28:PRINT "Nein"
  283. ChekMouse:
  284. IF MOUSE(0)=0 THEN ChekMouse
  285. w=MOUSE (3):q=MOUSE (2)
  286. IF w>0 AND w<101 AND q>50 AND q<91 THEN WINDOW CLOSE 2:GOTO Hinzufugen
  287. IF w>189 AND w<291 AND q>50 AND q<91 THEN WINDOW CLOSE 2:GOTO Anfang
  288. GOTO ChekMouse
  289.  
  290.